1 'Created on August 16, 2010
2 'Tan, Angelito S.
3
4 'Date update dec 12, 2010
5 Option Explicit On
6 Imports System.IO
7 Module ModProcedure
8 Dim xsize As Integer
9 'load data in the listview
10 Public Sub FillListView(ByVal sqlData As DataTable, ByVal lvList As ListView, ByVal imageID As Integer)
11 Dim i As Integer
12 Dim j As Integer
13 'lvList.Refresh()
14 lvList.Clear()
15 For i = 0 To sqlData.Columns.Count - 1
16 lvList.Columns.Add(sqlData.Columns(i).ColumnName)
17 Next i
18
19 For i = 0 To sqlData.Rows.Count - 1
20 lvList.Items.Add(sqlData.Rows(i).Item(0), imageID)
21 For j = 1 To sqlData.Columns.Count - 1
22 If Not IsDBNull(sqlData.Rows(i).Item(j)) Then
23 lvList.Items(i).SubItems.Add(sqlData.Rows(i).Item(j))
24 Else
25 lvList.Items(i).SubItems.Add("")
26 End If
27 Next j
28 Next i
29
30 For i = 0 To sqlData.Columns.Count - 1
31 xsize = lvList.Width / sqlData.Columns.Count - 8
32 'MsgBox(xsize)
33 'If xsize > 1440 Then
34 lvList.Columns(i).Width = xsize
35 'Else
36 ' lvList.Columns(i).Width = 2000
37 'End If
38 'lvList.Columns(i).AutoResize(ColumnHeaderAutoResizeStyle.HeaderSize)
39 Next i
40 End Sub
41
42
43 Public Function str_Filter(ByVal Text As TextBox, ByVal ascKey1 As Integer, ByVal ascKey2 As Integer, ByVal ascKey3 As Integer, ByVal N_Repeat As Integer)
44 On Error Resume Next
45 '-----function dump all strings except
46 Dim Delimeter As String
47 Dim X As Long
48 Dim intStr As String
49 Dim NumberToRepeatCharacter As Integer
50
51 'MsgBox(Chr(Asc(Text.Text)))
52 'MsgBox(Asc(Text.Text))
53 For X = 1 To Len(Text.Text) 'asckey1 asckey2 asckey3
54 If Asc(Mid((Text.Text), X, 1)) >= ascKey1 And Asc(Mid((Text.Text), X, 1)) <= ascKey2 Or Asc(Mid(Text.Text, X, 1)) = ascKey3 Then
55 Else
56 Delimeter = Chr(Asc(Mid(Text.Text, X, 1)))
57 'MsgBox(Delimeter)
58 End If
59 Next
60 intStr = ""
61 For X = 1 To Len(Text.Text)
62 If N_Repeat > 0 Then
63 If Asc(Mid(Text.Text, X, 1)) = ascKey3 Then
64 If NumberToRepeatCharacter >= N_Repeat Then
65 SendKeys.Send("{END}")
66 Exit For
67 End If
68 NumberToRepeatCharacter = NumberToRepeatCharacter + 1
69 End If
70 End If
71 'If NumberToRepeatCharacter <> N_Repeat Then
72 If Mid(Text.Text, X, 1) <> Delimeter Then
73 intStr = intStr & Mid(Text.Text, X, 1)
74 'NumberToRepeatCharacter = NumberToRepeatCharacter + 1
75 Else
76 'can be uncomment if you want
77 'SendKeys.Send("{END}")
78 End If
79 ' Else
80 ' SendKeys.Send("{END}")
81 ' End If
82
83 'NumberToRepeatCharacter = X
84 Next
85 'MsgBox(NumberToRepeatCharacter)
86 str_Filter = intStr
87 End Function
88 Public Function filter_Special_Char(ByVal str As String)
89 filter_Special_Char = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(str, "!", ""), "@", ""), "#", ""), "$", ""), "%", ""), "^", ""), "&", ""), "*", ""), "(", ""), ")", ""), "_", ""), "+", "")
90 End Function
91
92 Public Function x_Access(ByRef xAccnt As String) As Boolean
93 If UCase(xAccnt) <> UCase("Administrator") Then
94 MsgBox("Only Administrator are allowed to access this module", MsgBoxStyle.Information, "Sales and Inventory")
95 x_Access = False
96 Else
97 x_Access = True
98 End If
99 End Function
100 Public Sub FormShow(ByVal frm As Form, ByVal edit As Boolean, ByVal iID As Integer, ByVal iID2 As Integer)
101 If edit = True Then
102 frm.Text = frm.Text & " - Edit"
103 Else
104 frm.Text = frm.Text & " - Add"
105 End If
106 If iID2 > 0 Then
107 globalID = iID & "x" & iID2 ' pass current ID
108 Else
109 globalID = iID ' pass current ID
110 End If
111 frm.ShowDialog()
112 End Sub
113 Public Sub FormClose(ByVal frmstr As Form)
114 Dim i As Integer
115 If frmstr.Name <> "FrmBG" Then
116 With MDIMain
117 For i = 0 To .lstShortCut.Items.Count - 1
118 If UCase(.lstShortCut.Items(i).Text) = UCase(frmstr.Text) Then
119 .lstShortCut.Items(i).Remove()
120 frmstr.Close()
121 Exit For
122 End If
123 Next
124 If UCase(frmstr.Name) = UCase("frmreports") Then
125 frmstr.Close()
126 ElseIf UCase(frmstr.Name) = UCase("frmreportsdated") Then
127 frmstr.Close()
128 End If
129 End With
130 End If
131 End Sub
132
133 Public Sub ActivatedToolbar(ByVal frmstr As Form)
134
135 'Debug.Print(frmstr.Name)
136 'MDIREFRESH()
137
138 With MDIMain
139 Select Case UCase(frmstr.Name)
140 Case UCase("frmcatlist")
141 MDIREFRESH()
142 Case UCase("frmsupplierslist")
143 MDIREFRESH()
144 Case UCase("frmpurchaseorder")
145 MDIREFRESH()
146 Case UCase("frmstockmonitoringbalances")
147 MDIREFRESH()
148
149 .cmdNew.Enabled = False
150 .cmdEdit.Enabled = False
151 .cmdDelete.Enabled = False
152
153 Case UCase("frmproducts_reorder")
154 MDIREFRESH()
155
156 .cmdNew.Enabled = False
157 .cmdEdit.Enabled = False
158 .cmdSearch.Enabled = False
159 .cmdDelete.Enabled = False
160
161 Case UCase("FrmDEFFECTIVE_RETURN_STOCKS")
162 MDIREFRESH()
163 .cmdDelete.Enabled = False
164
165 Case UCase("frmorder_form")
166 MDIREFRESH()
167
168 Case UCase("frmposreceipt_list")
169
170 .cmdNew.Enabled = False
171 .cmdEdit.Enabled = False
172 .cmdDelete.Enabled = False
173 .cmdRefresh.Enabled = True
174 .cmdSearch.Enabled = True
175 .cmdPrint.Enabled = True
176 .cmdClose.Enabled = True
177 '.cmdPrint.Enabled = False
178
179 Case UCase("frmposcashier")
180 'MDIDISABLED()
181
182 .cmdNew.Enabled = False
183 .cmdEdit.Enabled = False
184 .cmdSearch.Enabled = False
185 .cmdDelete.Enabled = False
186 .cmdRefresh.Enabled = False
187 .cmdPrint.Enabled = False
188 .cmdClose.Enabled = True
189
190 Case UCase("frmphysicalcount")
191 .cmdNew.Enabled = True
192 .cmdEdit.Enabled = True
193 .cmdSearch.Enabled = False
194 .cmdDelete.Enabled = True
195 .cmdRefresh.Enabled = True
196 .cmdPrint.Enabled = True
197 .cmdClose.Enabled = True
198
199 Case UCase("frmsuppliersproduct")
200 .cmdNew.Enabled = False
201 .cmdEdit.Enabled = False
202 .cmdDelete.Enabled = False
203
204 Case UCase("frmcatitemlist")
205 MDIREFRESH()
206
207 Case UCase("frmreports")
208 MDIDISABLED()
209 .cmdClose.Enabled = True
210
211 Case UCase("frmreportsdated")
212 MDIDISABLED()
213 .cmdClose.Enabled = True
214
215 Case UCase("frmaudit_trail")
216 .cmdNew.Enabled = False
217 .cmdEdit.Enabled = False
218 .cmdSearch.Enabled = False
219 .cmdDelete.Enabled = False
220 .cmdRefresh.Enabled = True
221 .cmdPrint.Enabled = True
222 .cmdClose.Enabled = True
223 Case UCase("frmbg")
224 MDIDISABLED()
225 End Select
226 End With
227 End Sub
228 Public Sub Audit_Trail(ByVal user_ID As Integer, ByVal xtime As String, ByVal xAction As String)
229 'For i = 1 To 800
230 sqlSTR = "INSERT INTO TBL_Audit_Trail (User_ID, Action, Date, Timex, log_ID) " & _
231 "VALUES (" & user_ID & ", " _
232 & "'" & xAction & "', " _
233 & "'" & Format(Now, "MM/dd/yyyy") & "', " _
234 & "'" & xtime & "', " _
235 & LOGID & ")"
236 ExecuteSQLQuery(sqlSTR)
237 ' Next
238 End Sub
239 Public Sub writeFileStrData(ByVal MyData As Object, ByVal filePath As String, Optional ByVal transType As String = "", Optional ByVal dataEncoding As String = "")
240
241 Dim Str As String
242 Dim fs As FileStream
243 Dim tempBytes() As Byte
244
245 tempBytes = Nothing
246
247 If transType = "" Then
248 transType = "Append" 'Set default
249 End If
250
251 If dataEncoding = "" Then
252 dataEncoding = "ANSI"
253 End If
254
255 Try
256 Str = CType(MyData, String)
257 'Str = CType(Split(MyData, "-")(0) & Chr(10) & Chr(13) & Split(MyData, "-")(1), String)
258 'MsgBox(Str)
259 If dataEncoding = "ANSI" Then
260 tempBytes = System.Text.Encoding.Default.GetBytes(Str)
261 ElseIf dataEncoding = "Unicode" Then
262 tempBytes = System.Text.Encoding.Unicode.GetBytes(Str)
263 End If
264
265 fs = New FileStream(filePath, FileMode.Create, FileAccess.Write)
266 If transType = "Append" Then
267 fs.Seek(0, SeekOrigin.End)
268 ElseIf transType = "Overwrite" Then
269 fs.Seek(0, SeekOrigin.Begin)
270 End If
271
272 fs.Write(tempBytes, 0, tempBytes.Length)
273 fs.Close()
274 Catch ex As Exception
275
276 MsgBox(ex.Message & vbCrLf & ex.StackTrace)
277 End Try
278
279 End Sub
280 Public Function R_eplace(ByVal str As String)
281 Return Replace(Replace(Replace(str, "'", "$.$"), ",", "$..$"), "`", "")
282 End Function
283 Public Function R_Change(ByVal str As String)
284 If Len(str) > 0 Then
285 Return Replace(Replace(Replace(str, "$.$", "'"), "$..$", ","), "`", "")
286 Else
287 Return ""
288 End If
289 End Function
290 End Module
